home *** CD-ROM | disk | FTP | other *** search
/ Power CD / Power CD ATARI-Rechner Lieben.iso / DEMOS / HM2_DEMO / BSP / ROBOTS.M < prev   
Encoding:
Text File  |  1992-07-09  |  6.5 KB  |  315 lines

  1. MODULE Robots;
  2.  
  3.   IMPORT InOut, GEMDOS, XBIOS;
  4.   FROM InOut IMPORT
  5.      Write, Read, WriteString, WriteLn;
  6.  
  7.   CONST
  8.      cIch = '@';
  9.      cRob = '=';
  10.      cBlech = '#';
  11.      cMampf = '*';
  12.      cLeer = ' ';
  13.      cESC = 33C;
  14.  
  15.      (* Scancodes                                     *)
  16.      Num0 = 112;     (* Teleport                 *)
  17.      Num1 = 109;     (* links unten             *)
  18.      Num2 = 110;     (* unten                     *)
  19.      Num3 = 111;     (* rechts unten             *)
  20.      Num4 = 106;     (* links                     *)
  21.      Num5 = 107;     (* warten                     *)
  22.      Num6 = 108;     (* rechts                     *)
  23.      Num7 = 103;     (* links oben              *)
  24.      Num8 = 104;     (* oben                      *)
  25.      Num9 = 105;     (* rechts oben             *)
  26.      NumMal = 102;  (* bis zum Ende warten  *)
  27.      Undo = 97;      (* Ende                      *)
  28.     
  29.   TYPE
  30.      tRoboter = RECORD
  31.         lebend: BOOLEAN;
  32.         X, Y: SHORTINT;
  33.     END;
  34.  
  35.   CONST
  36.      cMaxRoboter = 300;
  37.      cMaxZeile = 23;
  38.      cMaxSpalte = 79;
  39.  
  40.   VAR
  41.      RoboterListe: ARRAY[1..cMaxRoboter] OF tRoboter;
  42.      Besetzt: ARRAY[0..cMaxSpalte],[0..cMaxZeile] OF CHAR;
  43.      RoboterZahl: SHORTINT;
  44.      LebendeRoboter: SHORTINT;
  45.      TeleportsProEbene: SHORTINT;
  46.      FreieTeleports: SHORTINT;
  47.      Ebene: SHORTINT;
  48.      MeinX: SHORTINT;
  49.      MeinY: SHORTINT;
  50.      Gegessen: BOOLEAN;
  51.      Warten: BOOLEAN;
  52.  
  53.  
  54.   PROCEDURE RoboterSpiel;
  55.      VAR
  56.         x: CHAR;
  57.   BEGIN
  58.      REPEAT
  59.         FreieTeleports := 0;
  60.         TeleportsProEbene := 1;
  61.         Ebene := 0;
  62.         RoboterZahl := 0;
  63.         Gegessen := FALSE;
  64.         REPEAT
  65.           Warten := FALSE;
  66.           FreieTeleports := FreieTeleports + TeleportsProEbene;
  67.           INC (RoboterZahl, 10);
  68.           LebendeRoboter := RoboterZahl;
  69.           INC (TeleportsProEbene);
  70.           INC (Ebene);
  71.           ZeichneBildSchirm;
  72.           SetzeRoboter;
  73.           FreierPlatz (cIch, MeinX, MeinY);
  74.           Setze (cIch, MeinX, MeinY);
  75.           LOOP
  76.              SpielStand;
  77.              IF LebendeRoboter = 0 THEN EXIT END;
  78.              NaechsteBewegung;
  79.              RoboterBewegung;
  80.              IF Gegessen THEN EXIT END;
  81.           END;
  82.         UNTIL Gegessen;
  83.         Setze (' ', 0, 24);
  84.         WriteString ("Noch ein Spiel (j/n)?         ");
  85.         InOut.Read (x);
  86.      UNTIL CAP (x) = 'N'
  87.   END RoboterSpiel;
  88.  
  89.  
  90.   PROCEDURE ZeichneBildSchirm;
  91.      VAR
  92.         i, j: SHORTCARD;
  93.   BEGIN
  94.      (* Bildschirm loeschen *)
  95.      InOut.Write (cESC);
  96.      InOut.Write ('E');
  97.      (* Karte Loeschen *)
  98.      FOR i := 0 TO cMaxSpalte DO
  99.         FOR j := 0 TO cMaxZeile DO
  100.           Besetzt [i][j] := ' ';
  101.         END;
  102.      END;
  103.   END ZeichneBildSchirm;
  104.  
  105.  
  106.   PROCEDURE SetzeRoboter;
  107.      VAR
  108.         i, x, y: SHORTINT;
  109.   BEGIN
  110.      FOR i := 1 TO RoboterZahl DO
  111.         FreierPlatz (cRob, x, y);
  112.         WITH RoboterListe [i] DO
  113.           X := x;
  114.           Y := y;
  115.           lebend := TRUE;
  116.         END;
  117.         Setze (cRob, x, y);
  118.      END;
  119.   END SetzeRoboter;
  120.  
  121.  
  122.   PROCEDURE NaechsteBewegung;
  123.      VAR
  124.         c: SHORTCARD;
  125.         con: GEMDOS.tCconin;
  126.         x, y: SHORTINT;
  127.         Bewegt, Weiter: BOOLEAN;
  128.   BEGIN
  129.      Bewegt := FALSE;
  130.      REPEAT
  131.         REPEAT
  132.           Weiter := TRUE;
  133.           IF Warten THEN
  134.              c := Num5;
  135.           ELSE
  136.              con := GEMDOS.Crawcin ();
  137.              c := ORD (con.scan);
  138.           END;
  139.           CASE c OF
  140.              |Num7:
  141.                 x := -1; y := -1;
  142.              |Num9:
  143.                 x :=    1; y := -1;
  144.              |Num1:
  145.                 x := -1; y :=    1;
  146.              |Num3:
  147.                 x :=    1; y :=    1;
  148.              |Num4:
  149.                 x := -1; y :=    0;
  150.              |Num2:
  151.                 x :=    0; y :=    1;
  152.              |Num8:
  153.                 x :=    0; y := -1;
  154.              |Num6:
  155.                 x :=    1; y :=    0;
  156.              |Num5:
  157.                 x :=    0; y :=    0;
  158.              |Undo:
  159.                 GEMDOS.Pterm0;
  160.              |NumMal:
  161.                 x := 0; y := 0; Warten := TRUE;
  162.              |Num0:
  163.                 Weiter := FALSE;
  164.                 Setze (cLeer, MeinX, MeinY);
  165.                 IF FreieTeleports > 0 THEN
  166.                   DEC (FreieTeleports);
  167.                   REPEAT
  168.                   UNTIL NeuerPlatz (MeinX, MeinY) = cLeer;
  169.                   Setze (cIch, MeinX, MeinY);
  170.                 ELSE
  171.                   IF NeuerPlatz (MeinX, MeinY) = cLeer THEN
  172.                      Setze (cIch, MeinX, MeinY);
  173.                   ELSE
  174.                      Setze (cMampf, MeinX, MeinY);
  175.                      Gegessen := TRUE;
  176.                      Weiter := TRUE;
  177.                   END;
  178.                 END;
  179.           ELSE
  180.           END;
  181.         UNTIL Weiter;
  182.         IF ((MeinX + x) < 0) OR ((MeinX + x) > cMaxSpalte) OR
  183.             ((MeinY + y) < 0) OR ((MeinY + y) > cMaxZeile) THEN
  184.           InOut.Write (7C);
  185.         ELSE
  186.           Setze (cLeer, MeinX, MeinY);
  187.           Bewegt := TRUE;
  188.         END;
  189.      UNTIL Bewegt;
  190.      MeinX := MeinX + x;
  191.      MeinY := MeinY + y;
  192.      CASE Besetzt [MeinX, MeinY] OF
  193.         |cRob:
  194.           Setze (cMampf, MeinX, MeinY);
  195.           Gegessen := TRUE;
  196.         |cBlech:
  197.           IF ((MeinX + x) >= 0) AND ((MeinX + x) <= cMaxSpalte) AND
  198.               ((MeinY + y) >= 0) AND ((MeinY + y) <= cMaxZeile) AND
  199.               (Besetzt [MeinX + x, MeinY + y] = cLeer) THEN
  200.              Setze (cBlech, MeinX + x, MeinY + y);
  201.              Setze (cIch, MeinX, MeinY);
  202.           ELSE
  203.              MeinX := MeinX - x;
  204.              MeinY := MeinY - y;
  205.              Setze (cIch, MeinX, MeinY);
  206.           END;
  207.         |cLeer:
  208.           Setze (cIch, MeinX, MeinY);
  209.      END;
  210.   END NaechsteBewegung;
  211.  
  212.  
  213.   PROCEDURE RoboterBewegung;
  214.      VAR
  215.      i, j: SHORTINT;
  216.   BEGIN
  217.      FOR i := 1 TO RoboterZahl DO
  218.         WITH RoboterListe [i] DO
  219.           IF lebend THEN
  220.              Setze (' ', X, Y);
  221.              IF X > MeinX THEN
  222.                 DEC (X);
  223.              ELSIF X < MeinX THEN
  224.                 INC (X);
  225.              END;
  226.              IF Y > MeinY THEN
  227.                 DEC (Y);
  228.              ELSIF Y < MeinY THEN
  229.                 INC (Y);
  230.              END;
  231.           END;
  232.         END;
  233.      END;
  234.      FOR i := 1 TO RoboterZahl DO
  235.         WITH RoboterListe [i] DO
  236.           IF lebend THEN
  237.              CASE Besetzt [X, Y] OF
  238.                 |cLeer:
  239.                   Setze (cRob, X, Y);
  240.                 |cRob:
  241.                   Setze (cBlech, X, Y);
  242.                   lebend := FALSE;
  243.                   DEC (LebendeRoboter);
  244.                   FOR j := 1 TO RoboterZahl DO
  245.                      IF (X = RoboterListe [j].X) AND
  246.                          (Y = RoboterListe [j].Y) AND
  247.                         RoboterListe [j].lebend THEN
  248.                         RoboterListe [j].lebend := FALSE;
  249.                         DEC (LebendeRoboter);
  250.                      END;
  251.                   END;
  252.                 |cBlech:
  253.                   lebend := FALSE;
  254.                   DEC (LebendeRoboter);
  255.                 |cIch:
  256.                   Setze (cMampf, X, Y);
  257.                   Gegessen := TRUE;
  258.              END;
  259.           END;
  260.         END;
  261.      END;
  262.   END RoboterBewegung;
  263.  
  264.  
  265.   PROCEDURE FreierPlatz (z: CHAR; VAR x, y: SHORTINT);
  266.   BEGIN
  267.      REPEAT
  268.      UNTIL NeuerPlatz (x, y) = ' ';
  269.      Besetzt [x][y] := z;
  270.   END FreierPlatz;
  271.  
  272.  
  273.   PROCEDURE NeuerPlatz (VAR x, y: SHORTINT): CHAR;
  274.   BEGIN
  275.      x := Random (cMaxSpalte+1);
  276.      y := Random (cMaxZeile+1);
  277.      RETURN Besetzt [x][y];
  278.   END NeuerPlatz;
  279.  
  280.  
  281.   PROCEDURE Setze (z: CHAR; x, y: SHORTCARD);
  282.   BEGIN
  283.      IF (x <= cMaxSpalte) AND (y <= cMaxZeile) THEN
  284.          Besetzt [x, y] := z;
  285.      END; (* IF *)
  286.      InOut.Write (cESC);
  287.      InOut.Write ('Y');
  288.      InOut.Write (CHR (ORD (' ') + y));
  289.      InOut.Write (CHR (ORD (' ') + x));
  290.      InOut.Write (z);
  291.   END Setze;
  292.  
  293.  
  294.   PROCEDURE SpielStand;
  295.   BEGIN
  296.      Setze ('(', 0, 24);
  297.      InOut.WriteCard (FreieTeleports, 0);
  298.      InOut.WriteString (")  ");
  299.      InOut.WriteCard (Ebene, 0);
  300.      InOut.WriteString (". Ebene; ");
  301.      InOut.WriteInt (LebendeRoboter, 0);
  302.      InOut.WriteString (" Roboter        ");
  303.   END SpielStand;
  304.  
  305.  
  306.   PROCEDURE Random (n: LONGCARD): LONGCARD;
  307.   BEGIN
  308.      RETURN LONGCARD(XBIOS.Random ()) MOD n;
  309.   END Random;
  310.  
  311.  
  312. BEGIN
  313.     RoboterSpiel;
  314. END Robots. 
  315.             
  316.     
  317.